home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbvarc.arc / QBARCV.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-08-06  |  1.5 KB  |  59 lines
  1. '$page $subtitle:'QBARCV example - LA command'
  2. '
  3. ' input:
  4. '   - set FILE$ to the LA argument, the name of an ARC file
  5. '   - include completely qualified drive and path names unless
  6. '     a FILEPATH utility is in use
  7. ' output:
  8. '   - the file TEMPARC.DIR is created by the QBARCV subroutine,
  9. '     it contains either a verbose directory listing, or an
  10. '     error message
  11. '   - the RETCD return code contains:
  12. '          0 = okay,  1 = error,  2 = file not found
  13.  
  14. list.arc.dir: ' Uses Vern's QBARCV assembler sub. 8-7-86.
  15.  
  16. if q < 2 _
  17.   then _
  18.     gosub send : _
  19.     a$ = "Enter ARChive file name [.ARC] " : _
  20.     gosub receive : _
  21.     arc$ = b$(1) _
  22.   else _
  23.     arc$ = b$(2)
  24.  
  25. if arc$ = "" then goto files.menu
  26.  arc$ = fn cap.strip$(arc$)
  27. if instr(arc$,".") = 0 then arc$ = arc$ + ".ARC"
  28.  file$ = arc$
  29.  z$ = arc$
  30.  gosub protection.check
  31. if protected then goto files.menu
  32.  a$ = "Please wait. Extracting " + qu$ + file$ + qu$ + " ..."
  33.  gosub send2
  34.  retcode% = 0
  35.  
  36. call arcv(file$,retcode%)
  37.  
  38. if retcode% _
  39.   then
  40.     gosub send
  41.     a$ = "Sorry " + first$ + ", but an error occured while trying to do an ARCV"
  42.     gosub send
  43.     a$ = "on file " + qu$ + file$ + qu$ + ". Please leave " + sys1stnam$ + _
  44.      " a message about it."
  45.     gosub send
  46.     gosub press.enter
  47.     goto files.menu
  48. end if
  49.  
  50. file$ = "temparc.dir" ' Again, don't use a PATH!
  51. gosub send.file
  52. gosub send
  53. a$ = "End of directory. "
  54. gosub send1
  55. kill file$
  56. gosub press.enter
  57. goto files.menu
  58.  
  59.